home *** CD-ROM | disk | FTP | other *** search
Text File | 1988-04-18 | 8.1 KB | 279 lines | [TEXT/MPS ] |
- (*
- recvUpTo(termination character, waitTime,oldString) -- Return a string from the
- serial port; return everything available, up to the termination character (if any). Pass an empty
- termination character to receive everything available. WaitTime is the amount of time to wait
- for the input, in ticks (60ths of a second). oldString is what was read the last call (presumably
- terminated due to a time-out).
-
- To compile and link this file using Macintosh Programmer's Workshop,
-
- pascal -w recvUpTo.p
- link -m ENTRYPOINT -o HyperCommands -rt XFCN=7032 -sn Main=recvUpTo ∂
- recvUpTo.p.o "{MPW}"Libraries:interface.o
-
- © Copyright 1987,88 by Apple Computer, Inc.
-
- Initial coding 9/87 by Harry R. Chesley.
- *)
-
- {$R-}
-
- {$S recvUpTo } { Segment name must be the same as the command name. }
-
- unit DummyUnit;
-
- interface
-
- uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
-
- procedure EntryPoint(paramPtr: XCmdPtr);
-
- implementation
-
- const
-
- return = 13; { Carriage return. }
- linefeed = 10; { Line feed. }
- bs = 8; { Back space. }
- delete = 127; { Delete. }
- space = ord(' '); { Space. }
- tab = 9; { Horizontal tab. }
-
- type
-
- Str31 = String[31];
-
- procedure recvUpTo(paramPtr: XCmdPtr); forward;
-
- procedure EntryPoint(paramPtr: XCmdPtr);
-
- begin
- recvUpTo(paramPtr);
- end;
-
- procedure recvUpTo(paramPtr: XCmdPtr);
-
- var str: Str255;
- l: longInt;
- waitForChars: longInt; { Ticks to wait until for characters (compated to TickCount). }
- lookForTerm: boolean; { True if we're looking for a terminator character. }
- termChar: signedByte; { The terminator character we're looking for. }
- resultHand: Handle; { A handle to the result string. }
- resultSize: longInt; { The size of the result string (minus the zero termination tacked on last). }
- theChar: signedByte;
- p, p2: Ptr;
- col: integer; { The current column. }
- i,j: integer;
-
- {$I XCmdGlue.inc}
-
- procedure Fail(errMsg: Str255); { set theResult and quit }
- begin
- paramPtr^.returnValue := PasToZero(errMsg);
- exit(recvUpTo);
- end;
-
- {$I SPortUtil.inc}
-
- procedure sendByte(b: SignedByte);
- { Send one byte out the port. }
-
- var l: longInt;
-
- begin
- l := 1;
- if FSWrite(ThisSPort.portOutDev,l,@b) <> noErr then Fail('FSWrite failed');
- end;
-
- procedure sendCRLF;
- { Send a carriage return/linefeed out the port. }
-
- begin
- sendByte(return); sendByte(linefeed);
- end;
-
- procedure sendBS;
- { Backspace on a terminal attached to the port: backspace, then space to erase any character in the
- previous position, then backspace again to get the cursor in the right place. }
-
- begin
- sendByte(bs); sendByte(space); sendByte(bs);
- end;
-
- procedure disposAndFail(err: str255);
- { Fail routine used after the result handle has been allocated. }
-
- begin
- DisposHandle(resultHand);
- Fail(err);
- end;
-
- begin
- if paramPtr^.paramCount <> 3 then Fail('parameter count is not 3');
-
- SetUpSPortGlobals;
- EnsureOpenPort;
-
- GetStrParm(1,str); { First parameter is termination character. }
- if length(str) = 0 then lookForTerm := false
- else
- begin
- lookForTerm := true;
- termChar := SignedByte(str[1]);
- end;
- waitForChars := GetLongParm(2); { Second parameter is whether to wait. }
- resultHand := paramPtr^.params[3]; { Third parameter is the old string. }
-
- { If there's anything in the "previous" string, copy it. }
- if resultHand <> NIL then
- begin
- p := resultHand^;
- resultSize := 0;
- while p^ <> 0 do
- begin
- resultSize := resultSize + 1;
- p := Ptr(ord4(p)+1);
- end;
- if resultSize < 0 then Fail('Input string size too small!');
- if HandToHand(resultHand) <> noErr then Fail('HandToHand failed!');
- SetHandleSize(resultHand,resultSize);
- end
- { On the other hand, if the previous string is empty, make a new, empty one. }
- else
- begin
- resultHand := NewHandle(0);
- resultSize := 0;
- end;
-
- { Get our current idea of where the other side's cursor is. }
- col := ThisSPort.currentColumn;
-
- { Figure out when to stop trying (timeout). }
- waitForChars := waitForChars + TickCount;
-
- { Cycle until the timeout happens or we see the termintor character. }
- while true do
- begin
- { Check if there's any input from the port. }
- if SerGetBuf(ThisSPort.portInDev,l) <> noErr then disposAndFail('SerGetBuf failed');
- { If not, do another round or get out, depending on the timeout condition. }
- if l = 0 then
- begin
- if TickCount > waitForChars then leave
- else cycle;
- end;
-
- { Expand the result handle and read in the first character that's waiting. }
- resultSize := resultSize+1;
- SetHandleSize(resultHand,resultSize);
- if MemError <> noErr then disposAndFail('SetHandleSize failed!');
- HLock(resultHand);
- l := 1;
- if FSRead(ThisSPort.portInDev,l,Ptr(ord4(resultHand^)+resultSize-1)) <> noErr then
- disposAndFail('FSRead failed');
- HUnlock(resultHand);
-
- { Strip the character, if appropriate, and then get it into theChar. }
- p := Ptr(ord4(resultHand^)+resultSize-1);
- if ThisSPort.stripIncoming then p^ := BAND(p^,$7F);
- theChar := p^;
-
- { Weed out control characters, if appropriate. }
- if ThisSPort.stripControls then
- if (theChar < space) and (theChar <> tab) and (theChar <> return) and (theChar <> bs) then
- begin
- resultSize := resultSize-1;
- SetHandleSize(resultHand,resultSize);
- cycle;
- end;
-
- { If we're echoing... }
- if ThisSPort.doEcho then
- begin
- { If this is a backspace... }
- if ThisSPort.doEdit and ((theChar = bs) or (theChar = delete)) then
- begin
- if (col > 1) and (resultSize > 1) then
- begin
- sendBS;
- col := col-1;
- end;
- end
- { If it's a carriage return... }
- else if theChar = return then
- begin
- sendCRLF;
- col := 1;
- end
- { If it's a normal, non-wrapped character... }
- else if (col < WRAPCOLUMN) or (not ThisSPort.autoWrap) then
- begin
- sendByte(theChar);
- col := col+1;
- end
- { If it's a space in the wrap column (which only allows spaces)... }
- else if (theChar = space) and (col = WRAPCOLUMN) then
- begin
- sendByte(space);
- col := col+1;
- end
- { Otherwise, wrap the last word of the line onto the next line... }
- else
- begin
- { Figure out how many characters will wrap... }
- p := pointer(ord4(resultHand^)+resultSize);
- i := 0;
- while p <> resultHand^ do
- begin
- p := pointer(ord4(p)-1);
- if (p^ = space) or (p^ = return) then leave;
- i := i+1;
- end;
- { If it's the entire line, forget it. }
- if i >= MAXWRAP then i := 1;
- { If there's nothing to wrap, then just send a carriage return/linefeed. }
- if i = 0 then i := 1
- { Otherwise, backspace thru the characters being wrapped, then go to the next
- line, then send the wrapping characters. }
- else
- begin
- if i > 1 then for j := 1 to i-1 do sendBS;
- sendCRLF;
- for j := resultSize-i to resultSize-1 do
- sendByte(Ptr(ord4(resultHand^)+j)^);
- end;
- col := i+1;
- end;
- end;
-
- { If we're editing this line and this is the edit character... }
- if ThisSPort.doEdit and (theChar = bs) or (theChar = delete) then
- begin
- { Eliminate the backspace character. }
- resultSize := resultSize-1;
- { If we're allowed to edit it (i.e., it isn't on the previous line on the screen),
- eliminate the erased character. }
- if (col >= 1) or (not ThisSPort.doEcho) then resultSize := resultSize-1;
- { Make sure we're not deleting more than there is. }
- if resultSize < 0 then resultSize := 0;
- { Delete it. }
- SetHandleSize(resultHand,resultSize);
- end;
- if lookForTerm and (theChar = termChar) then leave;
- if resultSize > 30000 then leave;
- end;
-
- { Add in the zero termination for the string. }
- SetHandleSize(resultHand,resultSize+1);
- p := ptr(ord4(resultHand^)+resultSize);
- p^ := 0;
-
- { Return the handle. }
- paramPtr^.returnValue := resultHand;
-
- { Remember where we think the cursor column is. }
- Globals^^.ports[Globals^^.selectedPort].currentColumn := col;
- end;
-
- end.
-